home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / ace_gpl_release / src / ace / c / expr.c < prev    next >
Encoding:
C/C++ Source or Header  |  1998-10-04  |  24.1 KB  |  1,102 lines
  1. /* << ACE >>
  2.  
  3.    -- Amiga BASIC Compiler --
  4.  
  5.    ** Parser: Expression code **
  6.    ** Copyright (C) 1998 David Benn
  7.    ** 
  8.    ** This program is free software; you can redistribute it and/or
  9.    ** modify it under the terms of the GNU General Public License
  10.    ** as published by the Free Software Foundation; either version 2
  11.    ** of the License, or (at your option) any later version.
  12.    **
  13.    ** This program is distributed in the hope that it will be useful,
  14.    ** but WITHOUT ANY WARRANTY; without even the implied warranty of
  15.    ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16.    ** GNU General Public License for more details.
  17.    **
  18.    ** You should have received a copy of the GNU General Public License
  19.    ** along with this program; if not, write to the Free Software
  20.    ** Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  21.  
  22.    Author: David J Benn
  23.      Date: 26th October-30th November, 1st-13th December 1991,
  24.        14th,20th-27th January 1992, 
  25.            2nd-17th, 21st-29th February 1992, 
  26.        1st,13th,14th,22nd,23rd March 1992,
  27.        21st,22nd April 1992,
  28.        2nd,3rd,11th,15th,16th May 1992,
  29.        7th,8th,9th,11th,13th,14th,28th,29th,30th June 1992,
  30.        2nd-8th,14th-19th,26th-29th July 1992,
  31.        1st-3rd,7th,8th,9th August 1992,
  32.        6th,7th,21st December 1992,
  33.        28th February 1993,
  34.        12th June 1993,
  35.        12th,29th July 1994,
  36.        5th,6th November 1995
  37. */
  38.  
  39. #include "acedef.h"
  40.  
  41. /* externals */
  42. extern    int    sym;
  43. extern    int    factype;
  44. extern    int    negtype;
  45. extern    int    prodtype;
  46. extern    int    idivtype;
  47. extern    int    modtype;
  48. extern    int    simptype;
  49. extern    int    nottype;
  50. extern    int    andtype;
  51. extern    int    ortype;
  52. extern    int    eqvtype;
  53. extern    CODE    *curr_code;
  54. extern    int    labelcount;
  55. extern    char    tempstrname[80];
  56.  
  57. /* functions */
  58. BOOL coerce(typ1,typ2,cx)
  59. int  *typ1;
  60. int  *typ2;
  61. CODE *cx[];
  62. {
  63.  if ((*typ1 == stringtype) && (*typ2 != stringtype)) return(FALSE);
  64.  else
  65.  if ((*typ2 == stringtype) && (*typ1 != stringtype)) return(FALSE);
  66.  else
  67.  if (((*typ1 == shorttype) || (*typ1 == longtype)) && (*typ2 == singletype))
  68.  {
  69.   change_Flt(*typ1,cx);
  70.   *typ1=singletype;
  71.   return(TRUE);
  72.  }
  73.  else
  74.  if (((*typ2 == shorttype) || (*typ2 == longtype)) && (*typ1 == singletype))
  75.  {
  76.   gen_Flt(*typ2);
  77.   *typ2=singletype;
  78.   return(TRUE);
  79.  }
  80.  else
  81.  if ((*typ1 == shorttype) && (*typ2 == longtype)) 
  82.  {
  83.   change(cx[0],"move.w","(sp)+","d0");
  84.   change(cx[1],"ext.l","d0","  ");
  85.   change(cx[2],"move.l","d0","-(sp)");
  86.   *typ1=longtype;
  87.   return(TRUE);
  88.  }
  89.  else
  90.  if ((*typ2 == shorttype) && (*typ1 == longtype)) 
  91.  {
  92.   gen("move.w","(sp)+","d0");
  93.   gen("ext.l","d0","  ");
  94.   gen("move.l","d0","-(sp)");
  95.   *typ2=longtype;
  96.   return(TRUE);
  97.  }
  98.  else
  99.      return(TRUE); /* both shorttype, longtype or singletype OR notype! */
  100. }
  101.  
  102. void make_short()
  103. {
  104.  gen("move.l","(sp)+","d0");
  105.  gen("move.w","d0","-(sp)");
  106. }
  107.  
  108. void make_long()
  109. {
  110.  gen("move.w","(sp)+","d0");
  111.  gen("ext.l","d0","  ");
  112.  gen("move.l","d0","-(sp)");
  113. }
  114.  
  115. int ptr_term()
  116. {
  117. /* pointer operators -- higher precedence
  118.    than unary negation and exponentiation. */
  119.  
  120. int  localtype,op;
  121. BOOL dereference=FALSE;
  122.  
  123.   if (sym == shortpointer || sym == longpointer || sym == singlepointer)
  124.   {
  125.    op=sym;
  126.    dereference=TRUE;
  127.    insymbol();
  128.   }
  129.   
  130.   localtype=factor();
  131.  
  132.   if (dereference)
  133.   {
  134.    if (localtype != longtype)
  135.    {
  136.     _error(4);
  137.     localtype=undefined;
  138.    }
  139.    else
  140.    {
  141.     /* store address into a0 */
  142.     gen("move.l","(sp)+","a0");
  143.  
  144.     /* get value at address in a0 */    
  145.     switch(op)
  146.     {
  147.      /* *%<address> */    
  148.      case shortpointer : gen("move.w","(a0)","-(sp)");
  149.                   localtype=shorttype;
  150.                  break;
  151.  
  152.      /* *&<address> */    
  153.      case longpointer  : gen("move.l","(a0)","-(sp)");
  154.                  localtype=longtype;
  155.                  break;
  156.  
  157.      /* *!<address> */    
  158.      case singlepointer :gen("move.l","(a0)","-(sp)");
  159.                  localtype=singletype;
  160.                  break;
  161.     }
  162.    }
  163.   }
  164.   
  165.  return(localtype);
  166. }
  167.  
  168. int expterm()
  169. {
  170. /* exponentiation -> ALWAYS returns single */
  171. int  i;
  172. int  firsttype,original_firsttype,localtype,coercedtype;
  173. BOOL coercion;
  174. CODE *cx[5];
  175.  
  176.  firsttype=ptr_term();
  177.  localtype=firsttype;
  178.  
  179.  while (sym == raiseto)
  180.  {
  181.   if ((firsttype == shorttype) || (firsttype == longtype))
  182.   {
  183.    /* may need to coerce to singletype */
  184.    for (i=0;i<=4;i++)
  185.    {
  186.     gen("nop","  ","  ");
  187.     cx[i]=curr_code;
  188.    }
  189.   }
  190.  
  191.   insymbol();
  192.   factype=ptr_term();
  193.   if (factype == undefined) return(factype);
  194.   original_firsttype=firsttype; /* in case of SHORT->single coerce later */
  195.   coercion=coerce(&firsttype,&factype,cx);
  196.     
  197.   if (coercion)
  198.   {
  199.    coercedtype=factype;
  200.  
  201.    /* already singletype? */
  202.    if (coercedtype != singletype)
  203.    {
  204.     /* neither operands are singletype */ 
  205.     change_Flt(original_firsttype,cx); /* handles SHORT->single coerce */
  206.     gen_Flt(factype);
  207.    }
  208.  
  209.    gen("jsr","_power","  ");    /* - Call exponentiation function. */
  210.    gen("addq","#8","sp");    /* - Remove parameters from stack. */
  211.    gen("move.l","d0","-(sp)");  /* - Push the result. */
  212.                 
  213.    enter_XREF("_power");
  214.    enter_XREF("_MathTransBase"); /* opens FFP+IEEE SP transcendental libraries */
  215.  
  216.    localtype=singletype;  /* MUST always return a single-precision value
  217.                  because exponent might be -ve! */ 
  218.   } 
  219.   else _error(4); /* type mismatch */
  220.  
  221.   firsttype=localtype;  /* moving record of last sub-expression type */
  222.  }
  223.  return(localtype);
  224. }
  225.  
  226. int negterm()
  227. {
  228. int  localtype;
  229. BOOL negate=FALSE;
  230.  
  231.  /* unary negation? */
  232.  if (sym == minus) negate=TRUE;
  233.  if ((sym == minus) || (sym == plus)) insymbol();
  234.  
  235.  localtype=expterm();
  236.  if (localtype == undefined) return(localtype);
  237.  
  238.  if (negate)
  239.  {
  240.   switch(localtype)
  241.   {
  242.    case shorttype  : gen("neg.w","(sp)","  "); break;
  243.  
  244.    case longtype   : gen("neg.l","(sp)","  "); break;
  245.  
  246.    case singletype : gen("move.l","(sp)+","d0"); 
  247.        gen("move.l","_MathBase","a6");
  248.        gen("jsr","_LVOSPNeg(a6)","  ");
  249.        gen("move.l","d0","-(sp)");
  250.        enter_XREF("_MathBase");
  251.        enter_XREF("_LVOSPNeg");
  252.        break;
  253.    case stringtype : _error(4); break;
  254.   }
  255.  }
  256.  return(localtype);
  257. }
  258.  
  259. int prodterm()
  260. {
  261. /*
  262.    multiplication             -> returns long or single
  263.    floating-point division  -> returns single
  264. */
  265. int  op,i;
  266. int  firsttype,original_firsttype,localtype,coercedtype;
  267. BOOL coercion;
  268. CODE *cx[5];
  269.  
  270.  firsttype=negterm();
  271.  localtype=firsttype;
  272.  
  273.  while ((sym == multiply) || (sym == fdiv))
  274.  {
  275.   if ((firsttype == shorttype) || (firsttype == longtype))
  276.   {
  277.    /* may need to coerce to singletype or longtype */
  278.    for (i=0;i<=4;i++)
  279.    {
  280.     gen("nop","  ","  ");
  281.     cx[i]=curr_code;
  282.    }
  283.   }
  284.  
  285.   op=sym;  /* multiply or fdiv ? */
  286.  
  287.   insymbol();
  288.   negtype=negterm();
  289.  
  290.   if (negtype == undefined) return(negtype);
  291.  
  292.   /* save firsttype in case of a SHORT->single coercion 
  293.      later because coercion will need to start over again 
  294.      to avoid short->single code overwriting short->long code */
  295.  
  296.   original_firsttype=firsttype; 
  297.   coercion=coerce(&firsttype,&negtype,cx);
  298.     
  299.   /* if not stringtype, perform operation */
  300.   if (coercion) 
  301.   {
  302.    coercedtype=negtype;
  303.  
  304.    /* make sure operands are singletype if FFP division */
  305.    if ((op == fdiv) && (coercedtype != singletype))
  306.    {
  307.     /* neither operands are singletype 
  308.        -> both short or long */ 
  309.     change_Flt(original_firsttype,cx); /* handles SHORT->single correctly */
  310.     gen_Flt(negtype);
  311.     coercedtype=singletype;
  312.    }
  313.  
  314.    if ((op == multiply) && (coercedtype != longtype)) 
  315.       pop_operands(coercedtype);
  316.  
  317.    switch(op)
  318.    {
  319.     case multiply : switch(coercedtype)
  320.             {
  321.              case shorttype  :  gen("muls","d1","d0");
  322.                     localtype=longtype;
  323.                     break;
  324.             
  325.              case longtype   :    /* args on stack */
  326.                     gen("jsr","lmul","  "); 
  327.                     gen("add.l","#8","sp");
  328.                     enter_XREF("lmul");
  329.                     localtype=longtype;
  330.                     break;
  331.  
  332.              case singletype :  gen("movea.l","_MathBase","a6");
  333.                     gen("jsr","_LVOSPMul(a6)","  ");
  334.                     enter_XREF("_MathBase");
  335.                                enter_XREF("_LVOSPMul");
  336.                     localtype=singletype;
  337.                                break;
  338.             }
  339.             break;
  340.  
  341.     case fdiv     : gen("move.l","(sp)+","d1");  /* 2nd operand */
  342.             gen("move.l","(sp)+","d0");  /* 1st operand */
  343.             gen("movea.l","_MathBase","a6");
  344.             gen("jsr","_LVOSPDiv(a6)","  ");  
  345.             enter_XREF("_MathBase");
  346.                   enter_XREF("_LVOSPDiv");
  347.             localtype=singletype;
  348.                   break;
  349.    }
  350.  
  351.    push_result(localtype);  /* result */
  352.  
  353.   } 
  354.   else _error(4); /* notype -> type mismatch */
  355.  
  356.   firsttype=localtype;  /* moving record of last sub-expression type */
  357.  }
  358.  return(localtype);
  359. }
  360.  
  361. int idivterm()
  362. {
  363. /* integer division -- LONG = LONG \ LONG */
  364. int  i;
  365. int  firsttype,localtype;
  366. int  targettype=longtype;
  367. CODE *cx[5];
  368.  
  369.  firsttype=prodterm();
  370.  localtype=firsttype;
  371.  
  372.  while (sym == idiv) 
  373.  {
  374.   firsttype=make_integer(firsttype);  /* short or long -> 1st approximation */ 
  375.  
  376.   /* may need to coerce to long */
  377.   for (i=0;i<=2;i++)
  378.   {
  379.    gen("nop","  ","  ");
  380.    cx[i]=curr_code;
  381.   }
  382.  
  383.   if (firsttype == undefined) return(firsttype);
  384.  
  385.   coerce(&firsttype,&targettype,cx);  /* make sure it's a long dividend */
  386.   localtype=firsttype;
  387.  
  388.   insymbol();
  389.   prodtype=prodterm();
  390.   if (prodtype == undefined) return(prodtype); 
  391.   prodtype=make_integer(prodtype);  /* short or long at first */
  392.  
  393.   if ((firsttype != notype) && (prodtype != notype) &&
  394.       (firsttype != stringtype) && (prodtype != stringtype))
  395.   {
  396.    if (prodtype == shorttype) make_long();  /* ensure that divisor is LONG! */
  397.    prodtype=longtype;
  398.    localtype=prodtype;
  399.  
  400.    /* integer division - args on stack */
  401.    gen("jsr","ace_ldiv","  ");
  402.    gen("add.l","#8","sp");
  403.    gen("move.l","d0","-(sp)");
  404.    enter_XREF("ace_ldiv");
  405.   }
  406.   else _error(4); /* notype -> type mismatch */
  407.   firsttype=localtype;  /* moving record of last sub-expression type */
  408.  }
  409.  return(localtype);
  410. }
  411.  
  412. int modterm()
  413. {
  414. /* modulo arithmetic -> returns remainder of long integer or FFP division */
  415. int  i;
  416. int  firsttype,localtype;
  417. int  targettype=longtype;
  418. CODE *cx[5];
  419.  
  420.  firsttype=idivterm();
  421.  localtype=firsttype;
  422.  
  423.  while (sym == modsym) 
  424.  {
  425.   /* may need to coerce to single */
  426.   for (i=0;i<=4;i++)
  427.   {
  428.    gen("nop","  ","  ");
  429.    cx[i]=curr_code;
  430.   }
  431.  
  432.   if (firsttype == undefined) return(firsttype);
  433.  
  434.   insymbol();
  435.   idivtype=idivterm();
  436.  
  437.   if (idivtype == undefined) return(idivtype);
  438.  
  439.   /* perform integer or FFP modulo operation */
  440.   if ((firsttype != notype) && (idivtype != notype) &&
  441.       (firsttype != stringtype) && (idivtype != stringtype))
  442.   {
  443.    /* dividend (firsttype) is either short, long or single */
  444.  
  445.    if ((firsttype == singletype) || (idivtype == singletype))
  446.    {
  447.     /* single MOD */
  448.     coerce(&firsttype,&idivtype,cx);
  449.     /***************/
  450.    }
  451.    else 
  452.    {
  453.     /* integer MOD */
  454.     if (idivtype == shorttype)
  455.     {
  456.      make_long();  /* ensure that divisor is LONG! */
  457.      idivtype=longtype;
  458.     }
  459.     
  460.     if (firsttype == shorttype)
  461.        coerce(&firsttype,&targettype,cx);
  462.     /***************/
  463.    }
  464.  
  465.    localtype=idivtype;  /* short or single */
  466.  
  467.    if (localtype == longtype)
  468.    {
  469.     /* integer MOD - args on stack */
  470.     gen("jsr","ace_lrem","  ");
  471.     gen("add.l","#8","sp");
  472.     gen("move.l","d0","-(sp)");
  473.     enter_XREF("ace_lrem");
  474.    }
  475.    else
  476.    {
  477.     /* single MOD */
  478.     gen("move.l","(sp)+","d1");   /* divisor */
  479.     gen("move.l","(sp)+","d0");   /* dividend */
  480.     gen("jsr","_modffp","  ");
  481.     gen("move.l","d0","-(sp)");
  482.     enter_XREF("_modffp");
  483.     enter_XREF("_MathBase");
  484.     localtype=singletype;
  485.    }
  486.   }
  487.   else _error(4); /* notype -> type mismatch */
  488.   firsttype=localtype;  /* moving record of last sub-expression type */
  489.  }
  490.  return(localtype);
  491. }
  492.  
  493. int simple_expr()
  494. {
  495. int  op,i;
  496. int  firsttype,localtype;
  497. BOOL coercion;
  498. CODE *cx[5];
  499.  
  500.  firsttype=modterm();
  501.  localtype=firsttype;
  502.  
  503.  while ((sym == plus) || (sym == minus))
  504.  {
  505.   if ((firsttype == shorttype) || (firsttype == longtype))
  506.   {
  507.    /* may need to coerce */
  508.    for (i=0;i<=4;i++)
  509.    {
  510.     gen("nop","  ","  ");
  511.     cx[i]=curr_code;
  512.    }
  513.   }
  514.   op=sym;
  515.   insymbol();
  516.   modtype=modterm();
  517.   if (modtype == undefined) return(modtype);
  518.   coercion=coerce(&firsttype,&modtype,cx);
  519.   localtype=modtype;
  520.   if (coercion)
  521.   {
  522.    switch(op)
  523.    {
  524.     case plus :  if ((modtype != stringtype) && (modtype != shorttype))
  525.    {
  526.       gen("move.l","(sp)+","d1");
  527.     gen("move.l","(sp)+","d0");
  528.    }
  529.  
  530.    switch(modtype)
  531.    {
  532.     case shorttype  :     gen("move.w","(sp)+","d1");
  533.                   gen("move.w","(sp)+","d0");
  534.                     gen("add.w","d1","d0");
  535.                     break;
  536.  
  537.     case longtype   :    gen("add.l","d1","d0");
  538.                     break;
  539.  
  540.     case singletype :     gen("move.l","_MathBase","a6");
  541.                 gen("jsr","_LVOSPAdd(a6)","  ");
  542.                 enter_XREF("_LVOSPAdd");
  543.                 enter_XREF("_MathBase");
  544.                 break;
  545.  
  546.     case stringtype :     /* copy source to temp string */
  547.                 gen("move.l","(sp)+","a2"); /* 2nd */
  548.                 gen("move.l","(sp)+","a1"); /* 1st */
  549.             make_temp_string();
  550.                 gen("lea",tempstrname,"a0");
  551.                 gen("jsr","_strcpy","  ");
  552.                 /* prepare for strcat */
  553.                 gen("lea",tempstrname,"a0");
  554.                 gen("move.l","a2","a1");
  555.                 gen("jsr","_strcat","  ");
  556.                 gen("pea",tempstrname,"  ");
  557.                 enter_XREF("_strcpy");
  558.                 enter_XREF("_strcat");
  559.                 break;
  560.    }
  561.   
  562.    if (modtype == shorttype)
  563.             gen("move.w","d0","-(sp)");
  564.    else
  565.    if (modtype != stringtype)
  566.       gen("move.l","d0","-(sp)");
  567.                  break;
  568.  
  569.     case minus : if ((modtype != stringtype) && (modtype != shorttype))
  570.    {
  571.     gen("move.l","(sp)+","d1");
  572.     gen("move.l","(sp)+","d0");
  573.    }
  574.  
  575.    switch(modtype)
  576.    {
  577.     case shorttype  :     gen("move.w","(sp)+","d1");
  578.                     gen("move.w","(sp)+","d0");
  579.                 gen("sub.w","d1","d0");
  580.                     break;
  581.  
  582.     case longtype   :     gen("sub.l","d1","d0");
  583.                  break;
  584.  
  585.     case singletype :    gen("move.l","_MathBase","a6");
  586.                 gen("jsr","_LVOSPSub(a6)","  ");
  587.                    enter_XREF("_LVOSPSub");
  588.                 enter_XREF("_MathBase");
  589.                 break;
  590.  
  591.     case stringtype :     _error(4); break;
  592.   }
  593.   
  594.        if (modtype == shorttype)
  595.              gen("move.w","d0","-(sp)");
  596.        else
  597.            if (modtype != stringtype)
  598.               gen("move.l","d0","-(sp)");
  599.      }
  600.     } 
  601.     else _error(4); /* notype -> type mismatch */
  602.    firsttype=localtype;  /* moving record of last sub-expression type */
  603.   }
  604.  return(localtype);
  605. }
  606.  
  607. BOOL relop(op)
  608. int op;
  609. {
  610.  if ((op == equal) || (op == notequal) || (op == gtrthan) || 
  611.      (op == lessthan) || (op == gtorequal) || (op == ltorequal))
  612.      return(TRUE);
  613.  else
  614.      return(FALSE);
  615. }
  616.  
  617. char *cond_branch_op(op)
  618. int op;
  619. {
  620.  switch(op)
  621.  {
  622.   case equal     : return("beq.s");
  623.   case notequal  : return("bne.s");
  624.   case lessthan  : return("blt.s");
  625.   case gtrthan   : return("bgt.s");
  626.   case ltorequal : return("ble.s");
  627.   case gtorequal : return("bge.s");
  628.  }
  629. }
  630.  
  631. void make_label(name,lab)
  632. char *name;
  633. char *lab;
  634. {
  635. char num[40];
  636.  
  637.  strcpy(name,"_lab");
  638.  itoa(labelcount++,num,10);
  639.  strcat(name,num);
  640.  strcpy(lab,name);
  641.  strcat(lab,":\0");
  642. } 
  643.  
  644. int relexpr()
  645. {
  646. /* relational expression -> pass through this only ONCE */
  647. int  i,op=undefined;
  648. int  firsttype,localtype;
  649. char labname[80],lablabel[80],branch[6];
  650. BOOL coercion;
  651. CODE *cx[5];
  652.  
  653.  firsttype=simple_expr();
  654.  localtype=firsttype;
  655.  
  656.  if (relop(sym))
  657.  {
  658.   if ((firsttype == shorttype) || (firsttype == longtype))
  659.   {
  660.    /* may need to coerce */
  661.    for (i=0;i<=4;i++)
  662.    {
  663.     gen("nop","  ","  ");
  664.     cx[i]=curr_code;
  665.    }
  666.   }
  667.   op=sym;
  668.   insymbol();
  669.   simptype=simple_expr();
  670.   if (simptype == undefined) return(simptype);
  671.   coercion=coerce(&firsttype,&simptype,cx);
  672.   localtype=simptype;
  673.   if (coercion)
  674.   {
  675.    
  676.    /* compare on basis of type -> d5 = d0 op d1 */
  677.    switch(simptype)
  678.    {
  679.     case shorttype  :     gen("move.w","(sp)+","d1");  /* 2nd */
  680.                 gen("move.w","(sp)+","d0");  /* 1st */
  681.                 gen("moveq","#-1","d5");     /* assume true */
  682.                 gen("cmp.w","d1","d0");
  683.                 break;
  684.  
  685.     case longtype   :     gen("move.l","(sp)+","d1");  /* 2nd */
  686.                 gen("move.l","(sp)+","d0");  /* 1st */
  687.                 gen("moveq","#-1","d5");     /* assume true */
  688.                 gen("cmp.l","d1","d0");
  689.                 break;
  690.  
  691.     case singletype :     gen("move.l","(sp)+","d1");  /* 2nd */
  692.                 gen("move.l","(sp)+","d0");  /* 1st */
  693.                 gen("moveq","#-1","d5");     /* assume true */
  694.                 gen("move.l","_MathBase","a6");
  695.                 gen("jsr","_LVOSPCmp(a6)","  ");
  696.                 enter_XREF("_LVOSPCmp");
  697.                 enter_XREF("_MathBase");
  698.                 break;
  699.  
  700.     case stringtype :     gen("move.l","(sp)+","a1");  /* addr of 2nd string */
  701.             gen("move.l","(sp)+","a0");  /* addr of 1st string */
  702.             switch(op)
  703.             {
  704.              case equal     : gen("jsr","_streq","  ");
  705.                        enter_XREF("_streq");
  706.                       break;
  707.              case notequal  : gen("jsr","_strne","  ");
  708.                        enter_XREF("_strne");
  709.                       break;
  710.              case lessthan  : gen("jsr","_strlt","  ");
  711.                        enter_XREF("_strlt");
  712.                       break;
  713.              case gtrthan   : gen("jsr","_strgt","  ");
  714.                        enter_XREF("_strgt");
  715.                       break;
  716.              case ltorequal : gen("jsr","_strle","  ");
  717.                        enter_XREF("_strle");
  718.                       break;
  719.              case gtorequal : gen("jsr","_strge","  ");
  720.                        enter_XREF("_strge");
  721.                       break;
  722.             }
  723.             gen("move.l","d0","-(sp)"); /* push boolean result */
  724.             break;
  725.     }
  726.  
  727.     /* leave result on stack according to operator (-1 = true, 0 = false) */
  728.     /* (this code for short,long & single comparisons only) */
  729.     if (simptype != stringtype)
  730.     {    
  731.      make_label(labname,lablabel);
  732.      strcpy(branch,cond_branch_op(op));
  733.      gen(branch,labname,"  ");
  734.      gen("moveq","#0","d5"); /* not true */
  735.      gen(lablabel,"  ","  ");
  736.      gen("move.l","d5","-(sp)"); /* boolean result on stack */
  737.     }
  738.    } else _error(4);
  739.   }
  740.  
  741.  if (op == undefined) 
  742.     return(localtype);
  743.  else
  744.     return(longtype);  /* BOOLEAN! */  
  745. }
  746.  
  747. int notexpr()
  748. {
  749. int localtype,op;
  750.  
  751.  op=sym;
  752.  if (sym == notsym) insymbol();
  753.  
  754.  localtype=relexpr();
  755.  
  756.  if (op == notsym)
  757.  {
  758.   localtype=make_integer(localtype);
  759.   if (localtype == notype) return(localtype);
  760.   if (localtype == shorttype)
  761.    gen("not.w","(sp)","  ");
  762.   else
  763.    gen("not.l","(sp)","  ");
  764.  }
  765.  return(localtype);
  766. }
  767.   
  768. int andexpr()
  769. {
  770. int  op,i;
  771. int  firsttype,localtype;
  772. CODE *cx[5];
  773.  
  774.  firsttype=notexpr();
  775.  localtype=firsttype;
  776.  
  777.  if (sym == andsym)
  778.  {
  779.   firsttype=make_integer(firsttype);  
  780.   if (firsttype != notype)
  781.   {
  782.    while (sym == andsym)
  783.    {
  784.     if ((firsttype == shorttype) || (firsttype == longtype))
  785.     {
  786.      /* may need to coerce */
  787.      for (i=0;i<=4;i++)
  788.      {
  789.       gen("nop","  ","  ");
  790.       cx[i]=curr_code;
  791.      }
  792.     }
  793.     op=sym;
  794.     insymbol();
  795.     nottype=notexpr(); 
  796.     if (nottype == undefined) return(nottype);
  797.     nottype=make_integer(nottype);
  798.     coerce(&firsttype,¬type,cx);
  799.     localtype=nottype;
  800.     if (nottype != notype)
  801.     {
  802.      pop_operands(nottype);
  803.      if (nottype == shorttype) 
  804.      gen("and.w","d1","d0");
  805.      else
  806.      gen("and.l","d1","d0");
  807.      push_result(nottype);
  808.     } else _error(4);
  809.    }
  810.   } else _error(4);
  811.   firsttype=localtype;
  812.  }
  813.  return(localtype);
  814. }
  815.  
  816. int orexpr()
  817. {
  818. int  op,i;
  819. int  firsttype,localtype;
  820. CODE *cx[5];
  821.  
  822.  firsttype=andexpr();
  823.  localtype=firsttype;
  824.  
  825.  if ((sym == orsym) || (sym == xorsym))
  826.  {
  827.   firsttype=make_integer(firsttype);  
  828.   if (firsttype != notype)
  829.   {
  830.    while ((sym == orsym) || (sym == xorsym))
  831.    {
  832.    if ((firsttype == shorttype) || (firsttype == longtype))
  833.     {
  834.      /* may need to coerce */
  835.      for (i=0;i<=4;i++)
  836.      {
  837.       gen("nop","  ","  ");
  838.       cx[i]=curr_code;
  839.      }
  840.     }
  841.     op=sym;
  842.     insymbol();
  843.     andtype=andexpr();
  844.     if (andtype == undefined) return(andtype); 
  845.     andtype=make_integer(andtype);
  846.     coerce(&firsttype,&andtype,cx);
  847.     localtype=andtype;
  848.     if (andtype != notype)
  849.     {
  850.      pop_operands(andtype);  
  851.      switch(op)
  852.      {
  853.       case orsym  : if (andtype == shorttype)
  854.                gen("or.w","d1","d0");
  855.                     else
  856.                gen("or.l","d1","d0");
  857.                        break;
  858.  
  859.       case xorsym : if (andtype == shorttype)
  860.                   gen("eor.w","d1","d0");
  861.                   else
  862.                         gen("eor.l","d1","d0");
  863.                   break;
  864.      }
  865.      push_result(andtype);
  866.     } else _error(4);
  867.    }
  868.   } else _error(4);
  869.   firsttype=localtype;
  870.  }
  871.  return(localtype);
  872. }
  873.  
  874. int eqvexpr()
  875. {
  876. int  op,i;
  877. int  firsttype,localtype;
  878. CODE *cx[5];
  879.  
  880.  firsttype=orexpr();
  881.  localtype=firsttype;
  882.  
  883.  if (sym == eqvsym)
  884.  {
  885.   firsttype=make_integer(firsttype);  
  886.   if (firsttype != notype)
  887.   {
  888.    while (sym == eqvsym)
  889.    {
  890.    if ((firsttype == shorttype) || (firsttype == longtype))
  891.     {
  892.      /* may need to coerce */
  893.      for (i=0;i<=4;i++)
  894.      {
  895.       gen("nop","  ","  ");
  896.       cx[i]=curr_code;
  897.      }
  898.     }
  899.     op=sym;
  900.     insymbol();
  901.     ortype=orexpr(); 
  902.     if (ortype == undefined) return(ortype);
  903.     ortype=make_integer(ortype);
  904.     coerce(&firsttype,&ortype,cx);
  905.     localtype=ortype;
  906.     if (ortype != notype)
  907.     {
  908.      pop_operands(ortype);
  909.      if (ortype == shorttype) 
  910.      {
  911.          gen("jsr","_eqvw","  ");
  912.          enter_XREF("_eqvw");
  913.      }
  914.      else 
  915.        {
  916.          gen("jsr","_eqvl","  ");
  917.          enter_XREF("_eqvl");
  918.        }
  919.       push_result(ortype);
  920.     } else _error(4);
  921.    }
  922.   } else _error(4);
  923.   firsttype=localtype;
  924.  }
  925.  return(localtype);
  926. }
  927.  
  928. int expr()
  929. {
  930. int  op,i;
  931. int  firsttype,localtype;
  932. CODE *cx[5];
  933.  
  934.  firsttype=eqvexpr();
  935.  localtype=firsttype;
  936.  
  937.  if (sym == impsym)
  938.  {
  939.   firsttype=make_integer(firsttype);  
  940.   if (firsttype != notype)
  941.   {
  942.    while (sym == impsym)
  943.    {
  944.    if ((firsttype == shorttype) || (firsttype == longtype))
  945.    {
  946.      /* may need to coerce */
  947.      for (i=0;i<=4;i++)
  948.      {
  949.       gen("nop","  ","  ");
  950.       cx[i]=curr_code;
  951.      }
  952.     }
  953.     op=sym;
  954.     insymbol();
  955.     eqvtype=eqvexpr(); 
  956.     if (eqvtype == undefined) return(eqvtype);
  957.     eqvtype=make_integer(eqvtype);
  958.     coerce(&firsttype,&eqvtype,cx);
  959.     localtype=eqvtype;
  960.     if (eqvtype != notype)
  961.     {
  962.      pop_operands(eqvtype);
  963.      if (eqvtype == shorttype) 
  964.      {
  965.          gen("jsr","_impw","  ");
  966.          enter_XREF("_impw");
  967.      }
  968.      else 
  969.        {
  970.          gen("jsr","_impl","  ");
  971.          enter_XREF("_impl");
  972.        }
  973.      push_result(eqvtype);
  974.     } else _error(4);
  975.    }
  976.   } else _error(4);
  977.   firsttype=localtype;
  978.  }
  979.  return(localtype);
  980. }
  981.  
  982. void pop_operands(typ)
  983. int typ;
  984. {
  985.      if (typ == shorttype)
  986.      {
  987.       gen("move.w","(sp)+","d0");  /* 2nd operand */
  988.       gen("move.w","(sp)+","d1");  /* 1st operand -> d0 = d1 op d0 */
  989.      }
  990.      else
  991.      {  
  992.       gen("move.l","(sp)+","d0");  /* 2nd operand */
  993.       gen("move.l","(sp)+","d1");  /* 1st operand -> d0 = d1 op d0 */
  994.      } 
  995. }
  996.  
  997. void push_result(typ)
  998. int typ;
  999. {
  1000.  if (typ == shorttype)
  1001.     gen("move.w","d0","-(sp)");
  1002.  else
  1003.     gen("move.l","d0","-(sp)");
  1004. }
  1005.  
  1006. void gen_round(type)
  1007. int type;
  1008. {  
  1009. /*
  1010. ** Convert float to integer
  1011. ** with rounding.
  1012. */
  1013.   gen("move.l","(sp)+","d0");
  1014.   gen("jsr","_round","  ");
  1015.   gen("move.l","d0","-(sp)");
  1016.   enter_XREF("_round");
  1017.   enter_XREF("_MathBase");
  1018.  
  1019.   /*
  1020.   ** Only relevant when called from
  1021.   ** assign_coerce() and STOREType=shorttype.
  1022.   */
  1023.   if (type == shorttype)
  1024.   {
  1025.    gen("move.l","(sp)+","d0");
  1026.    gen("move.w","d0","-(sp)");
  1027.   }
  1028. }  
  1029.  
  1030. void gen_Flt(typ)
  1031. int typ;
  1032. {
  1033. /* convert an integer to a single-precision float */
  1034.   if (typ == singletype) return;  /* already a float! */
  1035.  
  1036.   if (typ == stringtype) _error(4); /* can't do it */
  1037.  
  1038.   if (typ == shorttype)
  1039.      gen("move.w","(sp)+","d0");
  1040.   else
  1041.      gen("move.l","(sp)+","d0");
  1042.  
  1043.   if (typ == shorttype) gen("ext.l","d0","  "); /* extend sign */
  1044.  
  1045.   gen("move.l","_MathBase","a6");
  1046.   gen("jsr","_LVOSPFlt(a6)","  ");
  1047.   gen("move.l","d0","-(sp)");
  1048.   enter_XREF("_LVOSPFlt");
  1049.   enter_XREF("_MathBase");
  1050. }
  1051.  
  1052. void change_Flt(exptyp,cx)
  1053. int  exptyp;
  1054. CODE *cx[];
  1055. {
  1056. /* convert an integer to a float */
  1057.   if (exptyp == shorttype)
  1058.      change(cx[0],"move.w","(sp)+","d0");
  1059.   else
  1060.      change(cx[0],"move.l","(sp)+","d0");
  1061.   if (exptyp == shorttype) change(cx[1],"ext.l","d0","  ");
  1062.   change(cx[2],"move.l","_MathBase","a6");
  1063.   change(cx[3],"jsr","_LVOSPFlt(a6)","  ");
  1064.   change(cx[4],"move.l","d0","-(sp)");
  1065.   enter_XREF("_LVOSPFlt");
  1066.   enter_XREF("_MathBase");
  1067. }
  1068.  
  1069. int make_integer(oldtyp)
  1070. int oldtyp;
  1071. {
  1072.  if (oldtyp == stringtype) return(notype); /* can't do it! */
  1073.  else
  1074.  if (oldtyp == singletype) 
  1075.  { 
  1076.   gen_round(oldtyp);
  1077.   return(longtype); 
  1078.  }
  1079.  else
  1080.  return(oldtyp);  /* already an integer */
  1081. }
  1082.  
  1083. void make_sure_short(type)
  1084. int type;
  1085. {
  1086.  if (type == longtype) make_short();
  1087.  else
  1088.  if (type == singletype) { make_integer(type); make_short(); }
  1089.  else
  1090.  if (type == stringtype) _error(4);
  1091. }
  1092.  
  1093. void make_sure_long(type)
  1094. int type;
  1095. {
  1096.  if (type == shorttype) make_long();
  1097.  else
  1098.  if (type == singletype) make_integer(type);
  1099.  else
  1100.  if (type == stringtype) _error(4);
  1101. }
  1102.